home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / monolith / ISTLP.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  4.9 KB  |  135 lines
  1. C
  2. C  MONOLITHIC VERSION OF POLISHING TOOL
  3. C
  4.       PROGRAM ISTLP
  5.  
  6. C---------------------------------------------------------
  7. C    TOOLPACK/1    Release: 2.4
  8. C---------------------------------------------------------
  9. C
  10. C  TKLAST = LAST TOKEN NUMBER
  11. C
  12.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  13.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  14.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  15.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  16.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  17.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  18.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  19.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  20.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  21.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  22.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  23.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  24.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  25.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  26.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  27.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  28.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  29.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  30.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  31.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  32.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  33.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  34.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  35.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  36.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  37.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  38.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  39.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  40.  
  41.  
  42.       INTEGER POLPTH(81),SRCPTH(81),I,IODPOL,IODSRC,
  43.      +        RLBPTH(81),FMTPTH(81),SCRPTH(81),
  44.      +        OPTPTH(81),IODOPT,NOOPTS(2),PLOPT(134)
  45.  
  46.       INTEGER TMPFIL, DESCO, DESCI, NERROR
  47.       INTEGER TYPE, LENT, STRING(1322), STATUS, ZPLERR
  48.       INTEGER GETARG,OPEN,CREATE,CTOI,EQUAL, ZTKGTI, ZTKPTI
  49.       LOGICAL SCERR
  50.  
  51.       DATA (RLBPTH(I),I=1,11)/112,111,108,114,108,98,
  52.      +        46,116,109,112,129/
  53.      +     (FMTPTH(I),I=1,11)/112,111,108,102,109,116,
  54.      +        46,116,109,112,129/
  55.      +     (SCRPTH(I),I=1,11)/112,111,108,115,99,114,
  56.      +        46,116,109,112,129/
  57.       DATA  NOOPTS/45,129/
  58.       DATA  SCERR/.FALSE./
  59.  
  60. C Initialise TIE
  61.       CALL ZINIT
  62.  
  63. C Read paths from command file
  64.  
  65.       IF (GETARG(1,SRCPTH,81).EQ.-100) CALL NAMES(1,SRCPTH)
  66.       IF (GETARG(2,POLPTH,81).EQ.-100) CALL NAMES(2,POLPTH)
  67.       IF (GETARG(3,OPTPTH,81).EQ.-100) CALL NAMES(3,OPTPTH)
  68.  
  69. C Open required files
  70.  
  71.       IODSRC=OPEN(SRCPTH,0)
  72.       IF (IODSRC.EQ.-1) CALL ERROR('Can''t Open source path')
  73.       IODPOL=CREATE(POLPTH,1)
  74.       IF (IODPOL.EQ.-1) CALL ERROR('Can''t Open output file')
  75. C Default parameters are set up in block data POLBLK
  76.       IF (OPTPTH(1).NE.129 .AND. EQUAL(OPTPTH,NOOPTS).EQ.-3) THEN
  77.         IODOPT=OPEN(OPTPTH,0)
  78.         IF (IODOPT.EQ.-1) CALL ERROR('Can''t Open option file')
  79. C Setup user-specified option values
  80.         CALL PLOPTF(IODOPT)
  81.       END IF
  82.       DO 100 I=4,10
  83.         IF (GETARG(I,PLOPT,134).NE.-100)
  84.      +     CALL POLOPT(PLOPT,.FALSE.)
  85.  100  CONTINUE
  86.  
  87.       DESCI = ZTKGTI(0, IODSRC, -1)
  88.       DESCO = ZTKPTI(0, IODPOL, ZTKGTI(2, 0, 0))
  89.  
  90.    10 CONTINUE
  91.       CALL ZSCAN(TYPE, LENT, STRING, DESCI, STATUS)
  92.       IF (STATUS.EQ.-1) SCERR=.TRUE.
  93.       CALL ZUSCAN(TYPE, LENT, STRING, DESCO)
  94.       IF (TYPE.NE.TZEOF) GOTO 10
  95.  
  96.       IF (SCERR) THEN
  97.         CALL ZMESS('[ISTLP: Scanner erro'//'r(s) detected]', 2)
  98.         CALL ZQUIT (-1)
  99.       ENDIF
  100.  
  101.       NERROR = ZPLERR()
  102.       IF (NERROR .NE. 0) THEN
  103.         CALL ZCHOUT('[ISTLP: ',2)
  104.         CALL ZPTINT(NERROR,1,2)
  105.         CALL ZMESS('errors o'//'r warnings detected]', 2)
  106.         CALL ZQUIT(-1002)
  107.       ELSE
  108.         CALL ZMESS('[ISTLP Normal Termination]', 2)
  109.         CALL ZQUIT(-2)
  110.       ENDIF
  111.  
  112.       END
  113. C------------------------------------------------------
  114. C
  115. C PROMPT FOR A PATHNAME
  116. C
  117.       SUBROUTINE NAMES(NUMB,PATH)
  118.  
  119.       INTEGER NUMB,PATH(*)
  120.       INTEGER I,PROMPT(22,4)
  121.       INTEGER ZGTCMD
  122.  
  123.       DATA (PROMPT(I,1),I=1,14)/83,111,117,114,99,
  124.      +        101,32,102,105,108,101,58,32,129/,
  125.      +       (PROMPT(I,2),I=1,18)/80,111,108,105,115,104,
  126.      +        101,100,32,111,117,116,112,117,116,58,
  127.      +        32,129/
  128.      +       (PROMPT(I,3),I=1,14)/79,112,116,105,111,110,
  129.      +        32,102,105,108,101,58,32,129/
  130.  
  131.       CALL ZPRMPT(PROMPT(1,NUMB))
  132.       I=ZGTCMD(PATH,0)
  133.  
  134.       END
  135.